home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / LISP / XLISP / XLISP21S / sources / c / xldbug < prev    next >
Text File  |  1992-04-25  |  5KB  |  227 lines
  1. /* xldebug - xlisp debugging support */
  2. /*      Copyright (c) 1985, by David Michael Betz
  3.         All Rights Reserved
  4.         Permission is granted for unrestricted non-commercial use       */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern int xldebug;
  10. extern int xlsample;
  11. extern LVAL s_debugio,s_unbound,s_stderr;
  12. extern LVAL s_tracenable,s_tlimit,s_breakenable;
  13. extern LVAL true;
  14.  
  15. /* forward declarations */
  16. #ifdef ANSI
  17. void NEAR breakloop(char *hdr, char FAR *cmsg, char FAR *emsg, LVAL arg,  int cflag);
  18. #else
  19. FORWARD VOID breakloop();
  20. #endif
  21.  
  22.  
  23. /* xlabort - xlisp serious error handler */
  24. VOID xlabort(emsg)
  25.   char *emsg;
  26. {
  27.     xlsignal(emsg,s_unbound);
  28.     xlerrprint("error",NULL,emsg,s_unbound);
  29.     xlbrklevel();
  30. }
  31.  
  32. /* xlbreak - enter a break loop */
  33. VOID xlbreak(emsg,arg)
  34.   char FAR *emsg; LVAL arg;
  35. {
  36.     breakloop("break","return from BREAK",emsg,arg,TRUE);
  37. }
  38.  
  39. /* xlfail - xlisp error handler */
  40. VOID xlfail(emsg)
  41.   char *emsg;
  42. {
  43.     xlerror(emsg,s_unbound);
  44. }
  45.  
  46. /* xlerror - handle a fatal error */
  47. LVAL xlerror(emsg,arg)
  48.   char FAR *emsg; LVAL arg;
  49. {
  50.     if (!null(getvalue(s_breakenable)))
  51.         breakloop("error",NULL,emsg,arg,FALSE);
  52.     else {
  53.         xlsignal(emsg,arg);
  54.         xlerrprint("error",NULL,emsg,arg);
  55.         xlbrklevel();
  56.     }
  57.         return NIL;     /* actually doesn't return */
  58. }
  59.  
  60. /* xlcerror - handle a recoverable error */
  61. VOID xlcerror(cmsg,emsg,arg)
  62.   char FAR *cmsg, FAR *emsg; LVAL arg;
  63. {
  64.     if (!null(getvalue(s_breakenable)))
  65.         breakloop("error",cmsg,emsg,arg,TRUE);
  66.     else {
  67.         xlsignal(emsg,arg);
  68.         xlerrprint("error",NULL,emsg,arg);
  69.         xlbrklevel();
  70.     }
  71. }
  72.  
  73. /* xlerrprint - print an error message */
  74. VOID xlerrprint(hdr,cmsg,emsg,arg)
  75.   char *hdr, FAR *cmsg, FAR *emsg; LVAL arg;
  76. {
  77. /* TAA MOD -- start error message on a fresh line */
  78.     xlfreshline(getvalue(s_stderr));
  79.  
  80.     /* print the error message */
  81. #ifdef MEDMEM
  82.     sprintf(buf,"%s: ",hdr);
  83.     STRCAT(buf, emsg);
  84. #else
  85.     sprintf(buf,"%s: %s",hdr,emsg);
  86. #endif
  87.     errputstr(buf);
  88.  
  89.     /* print the argument */
  90.     if (arg != s_unbound) {
  91.         errputstr(" - ");
  92.         errprint(arg);
  93.     }
  94.  
  95.     /* no argument, just end the line */
  96.     else
  97.         errputstr("\n");
  98.  
  99.     /* print the continuation message */
  100.     if (cmsg != NULL) {
  101. #ifdef MEDMEM
  102.         strcpy(buf,"if continued: ");
  103.         STRCAT(buf, cmsg);
  104.         strcat(buf, "\n");
  105. #else
  106.         sprintf(buf,"if continued: %s\n",cmsg);
  107. #endif
  108.         errputstr(buf);
  109.     }
  110. }
  111.  
  112. #ifdef NEED_TO_REPLACE_BREAKLOOP
  113. /* $putpatch.c$: "MODULE_XLDBUG_C_BREAKLOOP_REPLACEMENT" */
  114. #else
  115.  
  116. /* breakloop - the debug read-eval-print loop */
  117. LOCAL VOID NEAR breakloop(hdr,cmsg,emsg,arg,cflag)
  118.   char *hdr, FAR *cmsg, FAR *emsg; LVAL arg; int cflag;
  119. {
  120.     LVAL expr,val;
  121.     CONTEXT cntxt;
  122.     int type;
  123.  
  124.     /* print the error message */
  125.     xlerrprint(hdr,cmsg,emsg,arg);
  126.  
  127.     /* flush the input buffer */
  128.     xlflush();
  129.  
  130.     /* do the back trace */
  131.     if (!null(getvalue(s_tracenable))) {
  132.         val = getvalue(s_tlimit);
  133.         xlbaktrace(fixp(val) ? (int)getfixnum(val) : -1);
  134.     }
  135.  
  136.     /* protect some pointers */
  137.     xlsave1(expr);
  138.  
  139.     /* increment the debug level */
  140.     ++xldebug;
  141.  
  142.     /* debug command processing loop */
  143.     xlbegin(&cntxt,CF_BRKLEVEL|CF_CLEANUP|CF_CONTINUE,true);
  144.     for (type = 0; type == 0; ) {
  145.  
  146.         /* setup the continue trap */
  147.         if ((type = setjmp(cntxt.c_jmpbuf)) != 0)
  148.             switch (type) {
  149.             case CF_CLEANUP:
  150.                 continue;
  151.             case CF_BRKLEVEL:
  152.                 type = 0;
  153.                 break;
  154.             case CF_CONTINUE:
  155.                 if (cflag) {
  156.                     dbgputstr("[ continue from break loop ]\n");
  157.                     continue;
  158.                 }
  159.                 else xlabort("this error can't be continued");
  160.             }
  161.  
  162.         /* print a prompt */
  163.         sprintf(buf,"%d> ",xldebug);
  164.         dbgputstr(buf);
  165.  
  166.         /* read an expression and check for eof */
  167.         if (!xlread(getvalue(s_debugio),&expr)) {
  168.             type = CF_CLEANUP;
  169.             break;
  170.         }
  171.  
  172.         /* save the input expression */
  173.         xlrdsave(expr);
  174.  
  175.         /* evaluate the expression */
  176.         expr = xleval(expr);
  177.  
  178.         /* save the result */
  179.         xlevsave(expr);
  180.  
  181.         /* Show result on a new line -- TAA MOD to improve display */
  182.         xlfreshline(getvalue(s_debugio));
  183.  
  184.         /* print it */
  185.         dbgprint(expr);
  186.     }
  187.     xlend(&cntxt);
  188.  
  189.     /* decrement the debug level */
  190.     --xldebug;
  191.  
  192.     /* restore the stack */
  193.     xlpop();
  194.  
  195.     /* check for aborting to the previous level */
  196.     if (type == CF_CLEANUP)
  197.         xlbrklevel();
  198. }
  199. #endif
  200.  
  201. /* baktrace - do a back trace */
  202. VOID xlbaktrace(n)
  203.   int n;
  204. {
  205.     FRAMEP fp, p;
  206.     int argc;
  207.     for (fp = xlfp; (n < 0 || n--) && !null(*fp); fp = fp - (int)getfixnum(*fp)) {
  208.         p = fp + 1;
  209.         errputstr("Function: ");
  210.         errprint(*p++);
  211.         if ((argc = (int)getfixnum(*p++)) != 0)
  212.             errputstr("Arguments:\n");
  213.         while (--argc >= 0) {
  214.             errputstr("  ");
  215.             errprint(*p++);
  216.         }
  217.     }
  218. }
  219.  
  220. /* xldinit - debug initialization routine */
  221. VOID xldinit()
  222. {
  223.     xlsample = 0;
  224.     xldebug = 0;
  225. }
  226.  
  227.